home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro3.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-02  |  6KB  |  205 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 3
  27. }
  28. PROGRAM TED_INTRO_NR3;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33. VAR
  34.  BITMAP         : ARRAY [1..40,0..319] OF BYTE;
  35.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  36.  CHARS          : ARRAY [' '..']'] OF POINTER;
  37.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  38.  F              : FILE;
  39.  B,ROW,NR       : BYTE;
  40.  X,Y,I,J        : INTEGER;
  41.  CH,K           : CHAR;
  42.  TEKST          : STRING;
  43.  SINUS          : ARRAY [0..255] OF BYTE;
  44.  SINN           : BYTE;
  45.  
  46. {───────────────────────────────────────────────────────────────────────────}
  47. PROCEDURE CALCSIN;
  48. VAR I : INTEGER;
  49. BEGIN
  50.  FOR I := 0 TO 255 DO SINUS[I] := ROUND(SIN(5*I*PI/455)*15)+70;
  51. END;
  52. {───────────────────────────────────────────────────────────────────────────}
  53. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  54. ASM
  55.  MOV AX,0013H
  56.  INT 10H
  57. END;
  58. {───────────────────────────────────────────────────────────────────────────}
  59. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  60. ASM
  61.  MOV AX,0003H
  62.  INT 10H
  63. END;
  64. {───────────────────────────────────────────────────────────────────────────}
  65. PROCEDURE VSYNC; ASSEMBLER;
  66. ASM
  67.  MOV DX,03DAH
  68.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  69.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  70. END;
  71. {───────────────────────────────────────────────────────────────────────────}
  72. PROCEDURE DRAWBITMAP(OFSiI: WORD); ASSEMBLER;
  73. ASM
  74.  MOV DI,OFSiI
  75.  MOV ES,SEGA000
  76.  MOV SI,OFFSET BITMAP
  77.  MOV CX,6400 { (LINES*320)/2  [40*320/2]=6400 }
  78.  CLD
  79.  REP MOVSW { USE WORD FOR SPEED UP }
  80. END;
  81. {───────────────────────────────────────────────────────────────────────────}
  82. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  83. ASM
  84.   LDS SI,MAP
  85.   LES DI,MAP
  86.   INC SI
  87.   INC SI
  88.   MOV CX,6400
  89.   REP MOVSW
  90. END;
  91. {───────────────────────────────────────────────────────────────────────────}
  92. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  93. ASM
  94.  MOV DX,3C8H
  95.  MOV AL,NR
  96.  OUT DX,AL
  97.  INC DX
  98.  MOV AL,R
  99.  OUT DX,AL
  100.  MOV AL,G
  101.  OUT DX,AL
  102.  MOV AL,B
  103.  OUT DX,AL
  104. END;
  105. {───────────────────────────────────────────────────────────────────────────}
  106. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  107. BEGIN
  108.  ASSIGN(F,NAME+'.PAL');
  109.  RESET(F,1);
  110.  BLOCKREAD(F,PALETTE,768);
  111.  CLOSE(F);
  112.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  113. END;
  114. {───────────────────────────────────────────────────────────────────────────}
  115. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  116. VAR TX,TY: BYTE; CH: CHAR;
  117. BEGIN
  118.  ASSIGN(F,NAME+'.TED');
  119.  RESET(F,1);
  120.  SEEK(F,20);
  121.  WHILE NOT(EOF(F)) DO
  122.  BEGIN
  123.   BLOCKREAD(F,CH,1);
  124.   BLOCKREAD(F,TX,1);
  125.   BLOCKREAD(F,TY,1);
  126.   GETMEM(CHARS[CH],TX*TY);
  127.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  128.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  129.  END;
  130.  CLOSE(F);
  131.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  132.  BEGIN
  133.   TX:=CHARSDATA['A',1];
  134.   TY:=CHARSDATA['A',2];
  135.   GETMEM(CHARS[' '],TX*TY);
  136.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  137.   CHARSDATA[' ',3]:=1;
  138.   CHARSDATA[' ',1]:=TX;
  139.   CHARSDATA[' ',2]:=TY;
  140.  END;
  141. END;
  142. {───────────────────────────────────────────────────────────────────────────}
  143. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  144. VAR CH: CHAR;
  145. BEGIN
  146.  FOR CH:=' ' TO ']' DO
  147.  BEGIN
  148.   IF CHARSDATA[CH,3]=1 THEN
  149.   BEGIN
  150.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  151.    CHARSDATA[CH,3]:=0;
  152.   END;
  153.  END;
  154. END;
  155. {───────────────────────────────────────────────────────────────────────────}
  156. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  157. VAR TX,TY: INTEGER;
  158. BEGIN
  159.  IF CHARSDATA[CH,3]<>1 THEN EXIT; { EXIT IF NO CHAR IN FONT }
  160.  FOR TY:=1 TO 40 DO BITMAP[TY,POS]:=0;
  161.  IF RO=CHARSDATA[CH,1]+1 THEN
  162.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY+5,POS]:=0 { SKIP ONE ROW }
  163.  ELSE
  164.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  165.    BITMAP[TY+5,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  166. END;
  167. {───────────────────────────────────────────────────────────────────────────}
  168. PROCEDURE UPDATE; { NEW VALUES ? }
  169. BEGIN
  170.  INC(ROW);
  171.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  172.  BEGIN
  173.   ROW:=1;
  174.   INC(NR);
  175.   IF NR>LENGTH(TEKST) THEN NR:=1;
  176.  END;
  177. END;
  178. {───────────────────────────────────────────────────────────────────────────}
  179.  
  180.  
  181.  
  182. BEGIN
  183.  CALCSIN;
  184.  INITVGA;
  185.  LOADPAL('FONT003');
  186.  LOADTED('FONT003');
  187.  ROW:=1;
  188.  TEKST:='WTF IS THAAAT??? ITS ANOTHER SHITTY SCROLLING ....                '+
  189.         'HM.. YEAH.. BUT THAT IS SINUS SCROLLING...                       ';
  190.  NR:=1;
  191.  SINN:=0;
  192.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  193.  REPEAT
  194.   SCROLLBITMAP(BITMAP);
  195.   UPDATE;
  196.   NEWROW(TEKST[NR],ROW,318);
  197.   UPDATE;
  198.   NEWROW(TEKST[NR],ROW,319);
  199.   DRAWBITMAP(SINUS[SINN]*320);
  200.   VSYNC;
  201.   INC(SINN); IF SINN=183 THEN SINN:=0;
  202.  UNTIL KEYPRESSED;
  203.  DONETED;
  204.  CLOSEVGA;
  205. END.